COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	~ This is part of the LISP core image monitoring system.  See REF for details.
C00005 00003	(DE $HC$ (FILE SWITCHES)
C00012 00004	(DE $PRINT-MSG$ ($X$$$)
C00014 ENDMK
C⊗;
~ This is part of the LISP core image monitoring system.  See REF for details.
~ first arg is $CALLI$ number.  Second is argument to $CALLI$, if any

(SETQ IBASE 8)

(LAP $CALLI$ SUBR)
	(MOVEM B TMPB)		~ store B in TMPB
	(PUSHJ P NUMVAL)
	(MOVEM A TMPA)		~ store A in TMPA
	(MOVE A TMPB)		~ convert B to a number
	(PUSHJ P NUMVAL)
	(MOVE B TMPA)		~ $CALLI$ number is now in B

	(047000 A 0 B)		~ $CALLI$ 1, indirect through 2
	(JRST 0 FIX1A)		~ change it back to a number
TMPA	(0)
TMPB	(0)
	NIL

(SETQ IBASE 10.)

(DE $PRINT-DATE$ ()
  (PROG	()
	(TERPRI)(TERPRI)
	(PRINC @"Checking changes for ")
	(PRINC (ADD1 (CDR (DIVIDE ($CALLI$ 12. 0) 31.))))
	(PRINC (QUOTE -))
	(PRINC (CAR (NTH @(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC) 
		      (ADD1 (CDR (DIVIDE (CAR (DIVIDE ($CALLI$ 12. 0) 31.)) 12.))))))
	(PRINC (QUOTE -))
	(PRINC (PLUS 1964. (CAR (DIVIDE (CAR (DIVIDE ($CALLI$ 12. 0) 31.)) 12.))))
	(PRINC (QUOTE / / / ))
	(PRINC (*QUO (*QUO ($CALLI$ 18. 0) 3600.) 60.))
	(PRINC (QUOTE :))
	(PRINC (REMAINDER (*QUO ($CALLI$ 18. 0) 3600.) 60.))
	(TERPRI)(TERPRI)
))
	
(SETQ BASE 10.)
(SETQ *NOPOINT T)
(DE $HC$ (FILE SWITCHES)
(PROG (DATACHAN OLDVAL OBL OBP OBA EXCLUDE LOGCHAN MSGCHAN
       FOLFEATURE LOGIT MSGIT
       STUFF ERRORDID TYPES EXPR FEXPR SUBR LSUBR MACRO FSUBR VALUE)

~ DATACHAN is the channel with the old data upon it.  OBL, OBP and OBA
~ are used for schanning through the OBLIST.  EXCLUDE is the list of things
~ on the oblists whose changing doesn't concern us.  LOGCHAN is the channel
~ for the log file; MSGCHAN, for the file to be mailed.  STUFF holds the
~ GETL of any atom.  ERRORDID is set true if any significant change is encountered.
~ OLDVAL is the value in the previous incarnation.


~ I'm not interested in change in the tokens of this function
	(SETQ FOLFEATURE (NOT (ZEROP (BOOLE 1 SWITCHES 4))))
	(SETQ LOGIT (NOT (ZEROP (BOOLE 1 SWITCHES 2))))
	(SETQ MSGIT (NOT (ZEROP (BOOLE 1 SWITCHES 1))))

	(SETQ EXCLUDE @(
			$CALLI$ $PRINT-DATE$
			DATACHAN MSGIT ERRORDID
			EXCLUDE EXPR FEXPR FILE FOLFEATURE FSUBR
			$HC$ LOGCHAN LOGIT LSUBR MACRO
			MSGCHAN OBA OBL OBLIST OBP OLDVAL
			$PRINT-MSG$
			STUFF SUBR SWITCHES TYPES VALUE $X$$$ $Y$$$
			))

	(SETQ ERRORDID NIL)

~ These are the types of things that might change
	(SETQ TYPES @(EXPR FEXPR SUBR LSUBR MACRO FSUBR VALUE))

~ Lookup the data file for this dmp image
	(SETQ DATACHAN (GENSYM))
	(EVAL (LIST @INOUT DATACHAN (CONS FILE @DAT)))

	(INC DATACHAN NIL)
	(MAPC (FUNCTION (LAMBDA($X$$$)(PROG ($Y$$$)
			(SET $X$$$ NIL)
		LOOP	(SETQ $Y$$$ (READ))
			(COND ((NULL $Y$$$)(RETURN T)))
			(SET $X$$$ (CONS $Y$$$ (EVAL $X$$$)))
			(GO LOOP))))
		TYPES)
	(INC NIL NIL)

~ Lookup the log file for this dmp image

	(COND (LOGIT
		(SETQ LOGCHAN (GENSYM))
		(EVAL (LIST @INOUT LOGCHAN (CONS FILE @LOG)))
		(OUTC LOGCHAN NIL)
		(USETO LOGCHAN T)
		($PRINT-DATE$)
		(OUTC NIL NIL)))

~ Create the message file
	(COND (MSGIT
	(SETQ MSGCHAN (GENSYM))
	(EVAL (LIST @OUTPUT MSGCHAN (CONS FILE @MSG)))
	(OUTC MSGCHAN NIL)
	($PRINT-DATE$)

	(COND	(FOLFEATURE
		 (COND	((GET @INIT @INIT)
			 (SETQ ERRORDID T)
			 (COND(LOGIT($PRINT-MSG$ (LIST LOGCHAN @INIT @IS/ SET 2))))
			 ($PRINT-MSG$ (LIST MSGCHAN @INIT @IS/ SET 2))))
		 (COND	(PROOF
			 (SETQ ERRORDID T)
			 (COND(LOGIT($PRINT-MSG$ (LIST LOGCHAN @PROOF @IS/ SET 2))))
			 ($PRINT-MSG$ (LIST MSGCHAN @PROOF @IS/ SET 2))))
		 (COND	(DECDONE
			 (SETQ ERRORDID T)
			 (COND(LOGIT($PRINT-MSG$ (LIST LOGCHAN @DECDONE @IS/ SET 2))))
			 ($PRINT-MSG$ (LIST MSGCHAN @DECDONE @IS/ SET 2))))))))

	(SETQ OBL OBLIST)
LOOP1	(COND	((NULL OBL)(GO ENDSCAN)))
	(SETQ OBP (CAR OBL))
	(SETQ OBL (CDR OBL))
LOOP2	(COND	((NULL OBP)(GO LOOP1)))
	(SETQ OBA (CAR OBP))
	(SETQ OBP (CDR OBP))
  (COND	((MEMQ OBA EXCLUDE)(GO LOOP2))
	((SETQ STUFF (GETL OBA TYPES))
	 (PROG ()
	  L    (COND	((NULL STUFF)(RETURN NIL))
			((MEMQ (CAR STUFF) TYPES)
			 (COND ((SETQ OLDVAL (ASSOC OBA (EVAL(CAR STUFF))))
			        (COND ((NOT(EQUAL (MAKNUM (CADR STUFF))(CDR OLDVAL)))
				    (SETQ ERRORDID T)
				    (COND(LOGIT($PRINT-MSG$ (LIST LOGCHAN (CAR STUFF) OBA 1))))
				    (COND(MSGIT($PRINT-MSG$ (LIST MSGCHAN (CAR STUFF) OBA 1))))
				    (RPLACD OLDVAL (MAKNUM (CADR STUFF))))))
			       (T (SETQ ERRORDID T)
				  (COND(LOGIT($PRINT-MSG$ (LIST LOGCHAN (CAR STUFF) OBA 0))))
				  (COND(MSGIT($PRINT-MSG$ (LIST MSGCHAN (CAR STUFF) OBA 0))))
				  (SET (CAR STUFF) (CONS
						    (CONS OBA (MAKNUM (CADR STUFF)))
						    (EVAL (CAR STUFF))))))))
	    (SETQ STUFF (CDDR STUFF))
	    (GO L))))
	(GO LOOP2)

ENDSCAN
	(COND	(ERRORDID
		 (OUTC NIL NIL)
		 (COND(LOGIT(OUTC LOGCHAN T)))
		 (COND(MSGIT(OUTC MSGCHAN T)))
		 (OUTC DATACHAN T)
		 (USETO DATACHAN 1)
		 (MAPC (FUNCTION (LAMBDA($X$$$)
			(PROG2
				(MAPC @PRINT (EVAL $X$$$))
				(PRINT NIL))))
			TYPES)
		(OUTC NIL T)))

	(RETURN ERRORDID)
))
(DE $PRINT-MSG$ ($X$$$)
(PROG ()
    (OUTC (CAR $X$$$) NIL)
    (TERPRI)
    (PRINC (CADDR $X$$$))
    (COND ((EQ (CADDDR $X$$$) 1)(PRINC @/ >/ ))
          ((EQ (CADDDR $X$$$) 2)(PRINC @/ #/ ))
	  ((EQ (CADDDR $X$$$) 0)(PRINC @/ !/ )))
    (PRINC (CADR $X$$$))
))